home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Wonky Flux Batch 2019 02
/
Wonky_Flux_Batch_2019-02.zip
/
Wonky Flux Batch 2019-02
/
072 - EXFER 4.1 4.2.dsk
/
EXFER.SEG.S
< prev
next >
Wrap
Text File
|
2019-02-17
|
29KB
|
795 lines
; *****************************
;
; EXfer:
; The Extended Transfer Module
;
; This program is for use on
; the ProDOS version of GBBS
; "Pro" 1.3
;
; Created and Copyrighted
; 1986 and 1987
; by Mike Golaszewski
;
; Copyright 1988 by G-Tech
; All Rights Reserved
;
; *****************************
; user segment, version 4.2
; Thanks to L&L Productions for protocol.up and protocol.down!
; created 6/20/88 - modified 7/25/88
; jpe Last Edited 9-26-88
; define linkable labels
public prompt
public send.2
public terminate
; store existing variables
enter
on nocar goto terminate
fill ram2,64,0:print \"XT: Loading EXfer, please hold...."
store "d:variables":gosub store:clear
gosub recall:screen$=chr$(13,2)+chr$(12):xt$=chr$(13)+"XT: "
byte=ram2:v=0:f$="b:sys.questions":gosub chkfil:close
if not(a) then v=13
f$="d:xt.users":gosub chkfil:close:if a create f$
open #1,f$:position #1,32,un:input #1,lc$
position #1,32,un,10:read #1,ram2,6:close
xm=byte(0):cr=byte(2)+byte(3)*256
if not(byte(1)) then cr=250:lc$=mid$(" "+date$,2)
ld$=lc$:pt=byte(5):pc=byte(4):b$=right$(lc$,3)+left$(lc$,5):lc$=b$
when$=ram2+16:ed=edit(5):if not(v) goto begin
byte=ram+37:dl=byte(3)+nibble(3)*256
ul=byte(4)+nibble(4)*256:byte=ram2
; check for bit map file
begin
f$="d:xt.bitmap":gosub chkfil:close
if (not(a)) goto begin.1:else fill ed+1,255,255
create f$:open #1,f$:write #1,ed+1,255:close
f$="d:xt.volumes":kill f$:create f$
; get XMODEM type
begin.1
print screen$
print " :::::::::::::::::::::::::::::::::::::"
print " : EXfer: The Extended Transfer Module :"
print " : Version 4.2.1 :"
print " : A.1 Computing~s Professional BBS :"
print " : Last Date in EXfer -->"ld$" :"
print " :::::::::::::::::::::::::::::::::::::"
if not(info(2)) input @2 \"Press [RETURN]...." i$:goto start
if byte(1) goto start
print xt$ ;:input @2 'Does your terminal program support
Ymodem "batch" transfers? ([Y]/N):' i$
i$=left$(i$,1):if i$<>"N" pt=1:xm=1:else xm=0:pt=0
print xt$ ;:input @2 "Are you using PC Pursuit? (Y/[N]):" i$
if i$<>"Y" pc=140:else pc=190
byte(0)=xm:byte(1)=1:byte(2)=cr mod 256:byte(3)=cr/256:byte(4)=pc
byte(5)=pt:open #1,"d:xt.users":position #1,32,un:print #1,date$
position #1,32,un,10:write #1,ram2,6:close
; try to access default library
start
print \"XT: Please hold...."
bb=c:gosub log:if bf$="" goto start.2
if not(b2) gosub lsec:goto exit.1
; got it, enter EXfer
start.1
gosub getslt:goto prompt
; library does not exist
start.2
if not(info(5)) print xt$;chr$(7)"Can't find default library....":goto exit.1
tone(30,30):print xt$"Source library does not exist...."
input @2 " Create? ([Y]/N):" i$:if i$<>"N" goto create:else goto exit.1
; get a command
prompt
on nocar goto terminate:ready d2$
x=(clock(2)-clock(1))/60:x$=right$("0"+str$(x),2)
if x=0 then x$="--":else if (info(5)) or (clock(1)=0) then x$="::"
free:clear key:print \chr$(14)"["x$"][EXfer Level] Option? (?=Help):";
if zz=1 then zz=0:goto command
if zz=3 goto command:else get i$:print chr$(8)" ";chr$(8);
; check for normal command
command
push prompt
if (i$="B") and (pt=1) goto batch
if i$="C" goto aux
if i$="D" f$="directory":goto aux.aux
if i$="F" f$="search":goto aux.aux
if i$="G" f$="global":goto aux.aux
if i$="H" goto aux
if i$="I" f$="aux.info":goto aux.aux
if (i$="J") or (i$="L") goto volume
if i$="K" goto aux
if i$="M" goto aux
if i$="N" f$="new":goto aux.aux
if i$="Q" f$="new":goto aux.aux
if i$="R" goto receive
if i$="S" goto send
if i$="T" goto hangup
if i$="V" goto aux
if i$="X" goto exit
if i$="W" goto aux
if i$="Y" then c=bb:flag(39)=0:pt=0:byte(1)=0:pop:goto begin.1
if (i$="?") or (i$="/") goto menu
; check for librarian command
if (not(lb)) and (not(info(5))) goto prompt.1
if i$="+" and (info(5)) then pt=1:return
if i$="A" and (info(5)) pop:link "a:exfer.sys","add"
if i$="E" and (info(5)) pop:link "a:exfer.sys","external"
if (i$="$") or (i$="-") pop:link "a:exfer.sys","credit"
if i$="O" pop:link "a:exfer.sys","sort"
if i$="P" and (info(5)) pop:ob=bb:goto create
if (i$="*") and (info(5)) input @2 "ProDOS: " i$:if i$ use "b:xdos",i$
if (i$="2") and (info(5)) pop:link "a:exfer.aux.2"
; not a command
prompt.1
print " "chr$(8);:return
; link to the auxilliary command segment
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
aux
pop:link "a:exfer.aux"
aux.aux
pop:link "a:exfer.aux","aux.aux"
; display a menu
; ~~~~~~~~~~~~~~
menu
print screen$\\s$:l=key(1)
f$="d:mnu.exfer80"
menu.1
open #1,f$:input #1,x$:setint(" ")
for l=1 to len(x$):addint(mid$(x$,l,1))
next:copy #1
if key(1) then a=key(0):goto menu.cancel
if key(3) goto menu.key
if (lb) and (f$<>"d:mnu.sysop") goto menu.sys
menu.cancel
close:setint(""):return
menu.key
close:setint(""):i$=chr$(key(0))
zz=1:print:return
menu.sys
close:setint(""):f$="d:mnu.sysop":goto menu.1
; send a file
; ~~~~~~~~~~~
; get name & verify it
send
if not(b3) goto lsec:else if zz=3 then zz=0:goto xsend
i$="N":if pt input @2 "Use Ymodem to download? ([Y]/N):" i$
i$=left$(i$,1):if i$<>"N" goto batch:else zz=3:i$="S":return
xsend
input @2 "Send:" i$:if i$="" return
if (val(i$)) or (left$(i$,1)="#") gosub nread:l=l-1:goto send.x
i$=left$(i$+chr$(32,14),15):gosub read
if not(l) goto nfile
send.x
if (l<0) goto nfile
if not(byte(9)) goto unval
na$=f$:gosub name:f$=bf$+f$:gosub chkfil
if a close:goto nfile
; compute time of transfer
close:x=((byte(10)+byte(11)*256)/2)*dm
if ((cr+1-x)<0) and (not(lb)) print '
XT: You don'"'"'t have enough credits to
download this file!':return
bs=byte(10)+byte(11)*256
gosub sendtime:print xt$'Estimated time of transfer is 'a'
minutes, 'c' seconds.':if clock(2)=0 goto send.1
if x<a print xt$;chr$(7)'You do not have enough time left to
download this file!':return
send.1
print xt$"Press <CR> to engage intelligent Xmodem....";:get i$:print
print xt$"Sending "bs+2" blocks...."
use "d:protocol.down",pc,0,f$
; update the record
send.2
on nocar goto terminate
d=0:if not(v) then byte=ram+29:byte(2)=byte(2)+1:byte=ram2:d=1
if v=13 then dl=dl+(peek(ed+3)=255):d=(peek(ed+3)=255)
byte(18)=byte(18)+1:nb=l
if d and (not(lb)) then x=((byte(10)+byte(11)*256)/2)*dm:if dm print '
XT: 'x' credits deducted.':cr=cr-x
push getslt:goto write
; send batch files
; ~~~~~~~~~~~~~~~~
batch
if not(b3) goto lsec:else print "Send batch files...."
print '
XT: Please enter your file list now. A blank entry will exit the selection
mode.'\:y=1:flag=ram2+21:fill ram2+20,44,0:pt=2:bs=0:d=cr
; get a file name or number
batch.1
print "Enter batch file #"right$("00"+str$(y),3);
input @2 ":" i$:if i$="" goto batch.2
if (val(i$)) or (left$(i$,1)="#") gosub nread:l=l-1:goto batch.x
i$=left$(i$+chr$(32,14),15):gosub read
if not(l) print chr$(8,24)"FILE DOESN'T EXIST!"chr$(7):goto batch.1
; make sure file is there and validated
batch.x
if l<0 print chr$(8,24)"FILE DOESN'T EXIST!"chr$(7):goto batch.1
if not(byte(9)) print chr$(8,24)"FILE MUST BE VALIDATED!"chr$(7):goto batch.1
if ty$="LST" print chr$(8,24)"ADDING LIST FILES!"chr$(7):goto lbatch
if lb gosub batch.d:goto batch.1
; check price & see if user has enough credits
z=((byte(10)+byte(11)*256)/2)*dm
if (d+1)-z<0 print chr$(8,24)"INSUFFICIENT CREDITS!"chr$(7):goto batch
d=d-z:gosub batch.d:goto batch.1
; ::::::::::::::::::::::::::::::::
; we have a file macro, process it
; ::::::::::::::::::::::::::::::::
lbatch
gosub name:f$=bf$+f$:open #2,f$
; fake an input to the user
lbatch.1
input #2,i$:if i$="" close:goto batch.1
if left$(i$,1)=";" goto lbatch.1
print "Enter batch file #"right$("00"+str$(y),3)": "i$
i$=left$(i$+chr$(32,14),15):gosub read
if not(l) print chr$(8,24)"FILE DOESN'T EXIST!"chr$(7):goto lbatch.1
; process what we have
if not(byte(9)) print chr$(8,24)"FILE MUST BE VALIDATED!"chr$(7):goto lbatch.1
if lb gosub batch.d:goto lbatch.1
; check the price & see if user has enough credits
z=((byte(10)+byte(11)*256)/2)*dm
if (d+1)-z<0 print chr$(8,24)"INSUFFICIENT CREDITS!"chr$(7):goto lbatch.1
d=d-z:gosub batch.d:goto lbatch.1
; ::::::::::::::::::::::::::::::::
; ready to send files using Ymodem
; ::::::::::::::::::::::::::::::::
; do an "estimated time of transfer" calculation
batch.2
y=y-1:if y=0 then flag=ram+22:pt=1:return
print xt$"Send "y;:input @2 " files? ([Y]/N):" i$
if i$="N" then flag=ram+22:pt=1:return
bs=bs+y/4:gosub sendtime:print '
XT: Estimated time of transfer is 'a' minutes, 'c' seconds.'
if (clock(2)=0) or (x>a) goto batch.3:else print '
XT: 'chr$(7)'You do not have enough time left to download these files!'
flag=ram+22:pt=1:return
; search for a file that has been marked
batch.3
bs=(bs-y/8):poke ram2+20,y:print xt$'Sending 'y' files....'
for l=2 to 255:if flag(l) goto batch.4:else next:goto batch.5
; found a marked file, get its ProDOS filename
batch.4
open #1,d1$:position #1,32,l
input #1,i$:input #1,ty$:read #1,ram2+9,10
close:na$=i$:gosub name:f$=bf$+f$
; send the file using Ymodem
use "d:protocol.down",pc,1,f$:byte(18)=byte(18)+1
if not(v) then byte=ram+29:byte(2)=byte(2)+1:byte=ram2
if v=13 then dl=dl+1
; update the "number of times downloaded" counter & search for more files
open #1,d1$:position #1,32,l:print #1,na$
print #1,ty$:write #1,ram2+9,10:close:next
; inform remote of EOT, deduct credits, reset FLAG pointer
batch.5
use "d:protocol.down",pc,1:flag=ram+22:pt=1
if dm and (not(lb)) print xt$;cr-d;" credits deducted!":cr=d:d=0
return
; SUBROUTINE - display & add block size, increment file counter
batch.d
z=((byte(10)+byte(11)*256)-1)*4
print chr$(8,24);i$" ["right$("000"+str$(z),4)"]"
if flag(l+1)=0 then y=y+1:bs=bs+(byte(10)+byte(11)*256)-(byte(10)>0)
flag(l+1)=1:return
; SUBROUTINE - find an empty message entry
findinfo
if msg(a) then a=a+1:else d=a:return
if a>msg(0) then d=a:return
goto findinfo
; receive a file
; ~~~~~~~~~~~~~~
; get filename & check for conflicts
receive
if not(b4) goto lsec:else if nb=255 goto dfull
if zz=3 then zz=0:goto recvx
i$="N":if pt input @2 "Use Ymodem to upload files? ([Y]/N):" i$
i$=left$(i$,1):if i$<>"N" goto rbch:else zz=3:i$="R":return
recvx
d=0:input @2 "Receive:" i$:if i$="" return
na$=left$(i$+chr$(32,14),15):i$=na$:gosub read
gosub name:f$=bf$+f$:gosub chkfil:close
if a and not(l) goto rec.a
if lb goto rec.1:else print '
XT: 'chr$(7)"Duplicate name on ProDOS volume!":return
; see what sysop wishes to do with duplicate
rec.1
if l then nb=l
input @2 \"XT: File exists....overwrite? ([Y]/N):" i$
if i$="N" return:else kill f$:d=byte(14)
; get the file
rec.a
x$=left$(i$+chr$(32,14),15)
create f$:print xt$"Ready to receive...."
y=clock(2):clock(2)=0:use "d:protocol.up",pc,0,f$:clock(2)=y
if not(v) then nibble(3)=nibble(3)+1:else ul=ul+(peek(ed+3)=255)
if (peek (10)=255) and (info(2)>0) print '
XT: The file you uploaded was received in
error and has been automatically
deleted....':kill f$:return
; compute some file info
gosub dtype:gosub size:if not(lb) then cr=cr+(a/2)*um
if um and (not(lb)) print xt$"You got "(a/2)*um" credits for this file!"
gosub sfile:byte(14)=0:if dd=1 then dd=0:x=254:gosub type:ty$="DDD"
; ask for a description
on nocar goto rec.4
if d print xt$'Do you want to change the existing
file information? ([Y]/N):';:else print xt$'Would you like to enter a short
description of this upload? ([Y]/N):';
input @2 i$:i$=left$(i$,1):if i$="N" goto rec.3
if d input #msg(d),a:input #6,x$\y$\z$:copy #6,#8
edit(0):gosub edesc:if not(edit(2)) goto rec.3
if d then byte(14)=d:kill #msg(d):update:goto rec.i
a=1:gosub findinfo
rec.i
kill #msg(d):print #msg(d),un:print #6,na$
print #6,"Uploader: "a1$" "a2$" [#"un"]"
print #6,"Uploaded: "date$" "time$\:copy #8,#6
msg(d)=255:update
rec.3
if d then byte(14)=d
if not(v) print xt$'If there is a problem with this
upload, use the "K" command to
delete it....'
push getslt:if nb<>byte(4) goto write:else goto update
; loss of carrier - save file and then hang up
rec.4
if d then byte(12)=d
push terminate:if nb<>byte(4) goto write:else goto update
; receive files using Ymodem batch
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
rbch
print '
XT: Ymodem batch will not overwrite existing files. If a file exists you
must delete it before transfer!'
x=0:d=0:print \xt$"Receiving batch; begin sending files now...."
; receive a file
rbch.1
i$=chr$(32,15):use "d:protocol.up",pc,1,bf$,i$:if i$=chr$(32,15) goto rbch.2
na$=i$:i$=left$(i$+chr$(32,14),15):gosub read:f$=bf$+na$:na$=i$
if peek(10)=255 kill f$:gosub trerr:goto rbch.1
p=0:if l then p=byte(14):nb=l
b=x:gosub dtype:x=b:b=a:gosub size:if um and (not(lb)) then d=d+(a/2)*um
byte(14)=p:gosub sfile:a=b:byte(14)=p:x=x+1
if nb<>byte(4) gosub write:else gosub update
gosub getslt:goto rbch.1
rbch.2
print xt$ ;x;" files received successfuly.":if um and (not(lb)) print '
XT: You received 'd' credits for your batch upload.':cr=cr+d
d=0:return
; log to a different library
; ~~~~~~~~~~~~~~~~~~~~~~~~~~
; get new volume & see if it exsists
volume
print "Go to a different library...."\xt$"Current library is #"bb
input @2 " Go to library [?]..." i$:if i$="" return
if i$="?" goto vol.2:else a=val(i$):if (a<1) or (a>255) print '
XT: 'chr$(7)"That library doesn't exist!":return
; try to log to library
ob=bb:bb=a:gosub log:if bf$="" then l=bb:gosub biterr:goto vol.1
if not(b2) gosub lsec:bb=ob:goto log
print xt$"Please hold....":gosub getslt
f$="directory":goto aux.aux
; find out if this library is to be created
vol.1
if not(info(5)) print '
XT: 'chr$(7)"That library doesn't exist!":bb=ob:goto log
tone(20,20):input @2 \"XT: Library doesn't exist....create? ([Y]/N):" i$
if i$="N" then bb=ob:goto log:else goto create
; scan bit map for available libraries
vol.2
print screen$"XT: You may access the following...."\\s$\
open #1,"d:xt.bitmap":read #1,ed+1,255:close
open #1,"d:xt.volumes":for l=1 to 255
setint(1):x=peek(ed+l):if key(1) then l=255:next:goto vol.4
if x>34 next:goto vol.4
if not(x) goto vol.3:else if flag(x) goto vol.3
next:goto vol.4
vol.3
position #1,32,l:input #1,x$
print "["right$("00"+str$(l),3)"]: "x$:next
; finished with list
vol.4
close:setint(""):print:clear key:goto volume
; hang up
; ~~~~~~~
; make sure user wishes to terminate call
hangup
input @2 "Hang up? (Y/[N]):" i$
if left$(i$,1)<>"Y" return
poke ram2+32,1:goto terminate
; restore GBBS variables and link to the terminate code
terminate
poke ram2+32,3
; SUBROUTINE - restore variables & do 1.3 conversions if needed
byecon
if cr<0 then cr=0
byte=ram2:byte(0)=xm:byte(1)=1:byte(2)=cr mod 256:byte(3)=cr/256
byte(5)=pt:byte(4)=pc:open #1,"d:xt.users":position #1,32,un:print #1,date$
position #1,32,un,10:write #1,ram2,6:close
poke ram2,v:when$=ram+20:if not(v) then byte=ram+29:goto byecon.1
byte=ram+37:nibble(3)=dl/256:byte(3)=dl mod 256
nibble(4)=ul/256:byte(4)=ul mod 256
byecon.1
print '
::::::::::::::::::::::::::::::::::::::::
: A.1 Computing~s Professional GBBS :
::::::::::::::::::::::::::::::::::::::::'
flag=ram+22:clear:recall "d:variables":kill "d:variables":x=peek(ram2)
if x=13 then ul=byte(4)+nibble(4)*256:dl=byte(3)+nibble(3)*256
if peek(ram2+32)=1 link "a:main.seg","termin2"
if peek(ram2+32)=2 link "a:main.seg","fromsys"
if peek(ram2+32)=3 link "a:main.seg","term1"
; exit back to the board
; ~~~~~~~~~~~~~~~~~~~~~~
; make sure the user wants to exit back to the bulletin board
exit
input @2 "Exit back to the BBS? ([Y]/N):" i$
if left$(i$,1)="N" return
; recall variables & add uploads & downloads
exit.1
poke ram2+32,2:goto byecon
; routines to edit or create libraries
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
create
link "a:exfer.sys","create"
; :::::::::::::::::::
; library subroutines
; :::::::::::::::::::
; log to a library and get some dir info
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
log
byte=ram2:fill ram2,32,0:bf$="":z$="d:xv."+str$(bb)
open #1,z$:input #1,bn$:input #1,bf$
read #1,ram2,9:close:b1=byte(5)+byte(6)*256
b2=1:if byte(0) then b2=flag(byte(0))
b3=1:if byte(1) then b3=flag(byte(1))
b4=1:if byte(2) then b4=flag(byte(2))
um=byte(7):dm=byte(8):lb=(un=b1)
if info(5) then lb=1:b2=1:b3=1:b4=1
d1$="d:xv."+str$(bb):d2$="d:dv."+str$(bb)
if bf$ ready d2$:bf$=left$(bf$,instr(":",bf$))
return
; get an empty slot
; ~~~~~~~~~~~~~~~~~
getslt
nb=0:open #1,d1$:for l=1 to byte(4)
position #1,32,l+1:input #1,i$
if (i$="") and (nb=0) then nb=l:l=byte(4)
next:close:if not(nb) then nb=byte(4)
return
; update "number of entries" counter
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
update
byte(4)=byte(4)+1
open #1,d1$:print #1,bn$
print #1,bf$:write #1,ram2,9:close
; write a directory entry
; ~~~~~~~~~~~~~~~~~~~~~~~
write
open #1,d1$:position #1,32,nb+1:print #1,na$
print #1,ty$:write #1,ram2+9,10:close
z=nb:return
; read a directory entry
; ~~~~~~~~~~~~~~~~~~~~~~
read
open #1,d1$:for l=1 to byte(4)
position #1,32,l+1:input #1,f$
if instr(i$,f$)=1 then p=l:l=byte(4):next:l=p:goto read.1
next:close #1:l=0:return
read.1
input #1,ty$:read #1,ram2+9,10:close #1
return
; read a file by slot #
; ~~~~~~~~~~~~~~~~~~~~~
nread
if left$(i$,1)="#" then i$=mid$(i$,2)
l=val(i$):if (l<2) or (l>253) then l=0:return
open #1,d1$:position #1,32,l
input #1,f$:if f$="" close #1:l=0:return
input #1,ty$:read #1,ram2+9,10:close #1
i$=f$:if pt=2 return:else print xt$"[#"l"]: "i$:return
; ::::::::::::::::::::::
; miscellaneous disk I/O
; ::::::::::::::::::::::
; find the type of a file
; ~~~~~~~~~~~~~~~~~~~~~~~
dtype
use "d:xtyp",f$:x=peek(ram2+32)
x$="???0TXT4PDA5BIN6ADB25AWP26ASP27SRC176OBJ177LIB178S16179RTL180EXE181"
x$=x$+"STR182RIF183NDA184CDA185SET186PNT192PIC193ANI194FNT200PAS239CMD240"
x$=x$+"COM245P16249BAS252VAR253REL254SYS255"
ty$="":y=instr(str$(x),x$):if y then ty$=mid$(x$,y-3,3):goto id
ty$="$"+chr$(48+x/16+((x/16)>9)*7)+chr$(48+x mod 16+((x mod 16)>9)*7)
; detect Macbinary or Binary ][ formats
id
x$=right$(f$,4)
if (x$=".BNY") or (x$=".BQY") or (x$=".SQZ") then ty$=right$(x$,3):return
open #1,f$:read #1,ram2+32,3:close #1
if (byte(32)=10) and (byte(33)=71) and (byte(34)=76) then ty$="BNY"
if (ty$="???") and ((byte(32)=0) and (byte(33))) then ty$="MAC"
return
; set the type of a file
; ~~~~~~~~~~~~~~~~~~~~~~
type
use "d:xtyp",f$,x:return
; return the size of F$ in A
; ~~~~~~~~~~~~~~~~~~~~~~~~~~
size
open #1,f$:a=size(1)/2+1:close:return
; see if file exists
; ~~~~~~~~~~~~~~~~~~
chkfil
open #1,f$:a=mark(1):return
; ::::::::::::::::::
; general processing
; ::::::::::::::::::
; set up directory entry in RAM2
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sfile
byte(9)=byte(3):byte(10)=a mod 256:byte(11)=a/256
byte(12)=un mod 256:byte(13)=un/256:byte(18)=0
when$="x":if lb then byte(9)=255
return
; convert user input to a valid ProDOS name
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; shorten I$ to directory length
name
if len(i$)>15 then i$=left$(i$,15)
i$=i$+chr$(1)
; make sure the first char is a letter
name.0
a=asc(left$(i$,1)):if a=1 pop:return
if (a>64) and (a<91) then i$=left$(i$,len(i$)-1):goto name.1
if (a>96) and (a<123) then i$=left$(i$,len(i$)-1):goto name.1
i$=mid$(i$,2):goto name.0
; remove symbols from the name
name.1
f$="":for x=1 to len(i$):a=asc(mid$(i$,x,1))
if (a>64) and (a<91) goto name.2
if (a>96) and (a<123) goto name.2
if (a>47) and (a<58) goto name.2
if a=46 goto name.2:else goto name.3
; add a valid character
name.2
f$=f$+chr$(a)
; if we dont have a name, return to the prompt
name.3
next:if f$="" pop:return
if len(f$)>15 then f$=left$(f$,15)
return
; :::::::::::::::::::::::::
; miscellaneous subroutines
; :::::::::::::::::::::::::
; save user's stats before CLEAR
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
store
clear #8:byte=ram2:byte(0)=c:byte(1)=un mod 256
byte(2)=un/256:print #8,a1$,a2$,s$:return
; recall a user's stats after CLEAR
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
recall
c=byte(0):un=byte(1)+byte(2)*256
input #8,a1$,a2$,s$:return
; compute an "estimated time of transfer"
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sendtime
x=bs/2:x=x+x/8:bs=bs*4:c=info(2)
if c=1 then b=x*34
if c=4 then b=x*9
if c=8 then b=x*4
; The following 2 lines are for 4800 and 9600 baud. Delete the ; if needed
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; if c=16 then b=x
; if c=32 then b=x/2
a=b/60:c=b mod 60:x=(clock(2)-clock(1))/60
bs=(byte(10)+byte(11)*256-(byte(10)>0))*4
return
; get a file description
; ~~~~~~~~~~~~~~~~~~~~~~
edesc
print '
Enter description: 'edit(3)' cols, [4K] max
[DONE] when finished, [.H] for help'
edit(1):return
; update errant bit-map
; ~~~~~~~~~~~~~~~~~~~~~
biterr
open #1,"d:xt.bitmap":read #1,ed+1,255:close
poke ed+l,255:open #1,"d:xt.bitmap"
write #1,ed+1,255:close:open #1,"d:xt.volumes"
position #1,32,l:print #1,chr$(13):close
return
; ::::::::::::::
; error messages
; ::::::::::::::
lsec
print \xt$ ;chr$(7)"Security too low....":return
dfull
print xt$ ;chr$(7)"Directory full....":return
nfile
print xt$ ;chr$(7)"No such file....":return
unval
print xt$ ;chr$(7)'File must be validated before it
can be accessed....':return
trerr
print xt$ ;chr$(7)"ERROR in transfer......":return